if (LEFT(ADDRESS(), 6) ~= "GOLDED") then /* not started by Golden ? */
address 'GOLDED.1'
'LOCK CURRENT RELEASE=4' /* lock GUI, gain access */
if (RC ~= 0) then
exit
OPTIONS FAILAT 6 /* ignore warnings */
SIGNAL ON SYNTAX /* ensure clean exit */
/* ------------------------ INSERT YOUR CODE HERE: ------------------- */
call rcs_login
'REQUEST BODY="This wizard will add RCS control*nto a directory. You will be able*nto choose which documents in the*ndirectory should be supervised." BUTTON="!OK"'
if (RC = 0) then do
'QUERY PATH VAR=PATH'
'REQUEST DIR TITLE="Add revision control to:" PATH="' || PATH || '" VAR=PRJDIR'
if ((RC = 0) & (PRJDIR ~= "")) then do
'EXPAND NAME="' || PRJDIR || '" VAR=PRJDIR'
if (RC = 0) then do
PRJNAME = ""
/* project directory already controlled by RCS ? */
if (exists(PRJDIR || "rcs_link")) then do
'REQUEST PROBLEM="RCS already installed for this drawer."'
call rcs_exit
end
if (exists(PRJDIR || "RCS") | exists(PRJDIR || "snapshot") | exists("PRJDIR || RCS_link")) then do
'REQUEST PROBLEM="Name conflict - can not add RCS control*nto this drawer. This directory seems to*nbe under RCS control but has not been*nconfigured with RCS for GoldED."'
call rcs_exit
end
/* obtain intial description and comment */
do while (PRJNAME = "")
'REQUEST STRING TITLE="' || PRJDIR || '" BODY="Choose a unique name for your project:" VAR=PRJNAME'
if (RC ~= 0) then
call rcs_exit
if (PRJNAME ~= "") then do
if (compress(PRJNAME, '*|"''') ~= PRJNAME) then do
'REQUEST PROBLEM="Project name contains invalid character(s)"'
'REQUEST TITLE="Project *"' || CONFIG.CFG_NAME || '*"" BODY="Select the documents (text files)*nto be put under RCS control. This*nwould typically be the files you*nplan to edit with GoldED." BUTTON="!SELECT"'
/* parse list of files ("file" "file" "file" ...) */
FILE = 0
do while (POS <= MAX)
do while ((substr(LIST, pos, 1) = " ") | (substr(LIST, pos, 1) = '"'))
POS = POS + 1
if (POS > MAX) then
leave
end
START = POS
LEN = 0
do while (POS <= MAX)
DATA = substr(LIST, POS, 1)
if ((DATA = ':') | (DATA = '/')) then do
START = POS + 1
POS = POS + 1
LEN = 0
end
else if (DATA = '"') then do
leave
end
else do
LEN = LEN + 1
POS = POS + 1
end
end
if (LEN ~= 0) then do
DATA = substr(LIST, START, LEN)
if (index(DATA, " ") ~= 0) then do
OLD = DATA
do while (index(DATA, " ") ~= 0)
'REQUEST TITLE="' || DATA || '" BODY="File name contains white space. RCS*ncan not handle white space in file*nnames. Would you like to rename the*nfile or should it be excluded from*nrevision control ?" BUTTON="!RENAME|E_xclude|_Cancel"'
if ((RC ~= 0) | (RESULT = 0)) then
call rcs_exit
if (RESULT = 2) then
leave
'REQUEST STRING BODY="Please choose new file name:" OLD="' || DATA || '" VAR=DATA'
end
if (DATA ~= OLD) then do
shell
'rename "' || OLD || '" "' || DATA || '"'
shell
if (exists(DATA) = 0) then do
'REQUEST PROBLEM="Error while renaming file."'
call rcs_exit
end
end
end
if (index(DATA, " ") = 0) then do
FILE = FILE + 1
CONFIG.CFG_SETUP.FILE = DATA
end
end
end
CONFIG.CFG_FILES = FILE
call rcs_getrevision "1.0 Initial revision code for your files"
'REQUEST PROBLEM="' || ERRORS || ' error(s) - ci failed to check in files.*nPlease use the ci command to login*nthe remaining files."'
end
'FILE DELETE FORCE NAME="t:rcs.logmsg"'
end
end
end
end
end
end
/* ---------------------------- END OF YOUR CODE --------------------- */
'UNLOCK' /* VERY important: unlock GUI */
exit
SYNTAX:
SAY "Sorry, error line" SIGL ":" ERRORTEXT(RC) ":-("
'UNLOCK'
exit
/* /// "rcs_login" */
rcs_login: procedure expose CONFIG.
if ((exists("rcs:ci") = 0) | (exists("rcs:co") = 0) | (exists("rcs:rcs") = 0) | (exists("rcs:setuprcs") = 0)) then do
'REQUEST PROBLEM="File(s) missing - Please install and|configure HWRCS before you continue"'
call rcs_exit
end
'QUERY $LOGNAME VAR=LOGNAME'
if (INDEX(LOGNAME, " ") ~= 0) then do
'REQUEST PROBLEM="User name contains invalid character.*nPlease note that the user name should*nbe like a login name (*"bill*") or an*ne-mail address and not like your real*nname."'
LOGNAME = ""
end
if ((LOGNAME = "") | (LOGNAME = "0")) then do
if (VERBOSE = "TRUE") then
'REQUEST PROBLEM="Please log in before you proceed.*nIt is required that every member of your*nworkgroup logs in under a unique name.*nLogin names will be used to keep track of*nthe files used and modified by various*nmembers of your workgroup.*n" BUTTON="!OK"'
else
'REQUEST PROBLEM="Please log in before you proceed."'
call rcs_quicklogin
end
return
/* /// */
/* /// "rcs_quicklogin" */
rcs_quicklogin: procedure expose CONFIG.
'QUERY $LOGNAME VAR=LOGNAME'
if (INDEX(LOGNAME, " ") ~= 0) then do
'REQUEST PROBLEM="User name contains invalid character.*nPlease note that the user name should*nbe like a login name (*"bill*") or an*ne-mail address and not like your real*nname."'
LOGNAME = ""
end
if ((LOGNAME = "") | (LOGNAME = "0")) then do
do while ((LOGNAME = "") | (LOGNAME = "0"))
'REQUEST STRING TITLE="Login" VAR=LOGNAME'
if (RC ~= 0) then do
'UNLOCK'
exit
end
if (INDEX(LOGNAME, " ") ~= 0) then do
'REQUEST PROBLEM="Login name contains invalid character.*nPlease note that the user name should*nbe like a login name (*"bill*") or an*ne-mail address and not like your real*nname."'
LOGNAME = ""
end
else if ((LOGNAME = "") | (LOGNAME = "0")) then
'REQUEST PROBLEM="Anonymous login not supported"'
else do
'SET $LOGNAME "' || LOGNAME || '"'
'REQUEST STATUS="Logged in as ' || LOGNAME || '."'
if ((RESULT = 1) | (RESULT = 2)) then do /* OK, HELP */
SNAPSHOT = CONFIG.CFG_SNAPSHOT
if (SNAPSHOT = "") then
SNAPSHOT = "snapshot"
if (RESULT = 2) then do
if (INDEX(SNAPSHOT, ":") = 0) then
MESSAGE = "This will create the new directory|""" || SNAPSHOT || """ in your project directory.|The snapshot directory will always|contain recent read-only copies of|your files.||A snapshot directory typically is|used to publish a recent version|of your project on a network. Your|compiler will find the source codes|in the snapshot directory if you|are a developer (you will have to|update your makefile)."
else
MESSAGE = "This will create the new directory|""" || SNAPSHOT || """. The snapshot directory|will always contain recent read-only|copies of your files.||A snapshot directory typically is|used to publish a recent version|of your project on a network. Your|compiler will find the source codes|in the snapshot directory if you|are a developer (you may need to|update your makefile)."
'REQUEST BODY="Please choose your working directory.*nEach member of your workgroup should*nhave a private working directory for*nthis project (on your local machine)." BUTTON="!OK"'
if (RC = 0) then do
do forever
'REQUEST DIR SAVE TITLE="Working directory..." PATH="sys:" VAR=PRJWORK'
if (RC = 0) then do
'EXPAND NAME="' || PRJWORK || '" VAR=PRJWORK'
CONFIG.CFG_WORK.USER = PRJWORK
if (exists(PRJWORK || "rcs_link") = 0) then do
if (exists(PRJWORK || "rcs_root") = 0) then do
call rcs_savelink USER
leave
end
else
'REQUEST PROBLEM="This directory is already used as*nworking directory by another user*nor for another project and can not*nbe selected again."'
end
else
leave
end
else
call rcs_exit
end
end
return
/* /// */
/* /// "rcs_savelink" */
rcs_savelink: procedure expose CONFIG.
parse arg USER
if (USER ~= 0) then do
PATH = CONFIG.CFG_WORK.USER || 'RCS_root'
R = open('CONFIG', PATH, 'WRITE')
if (R = 0) then
'REQUEST PROBLEM="Failed to save local configuration."'
